{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}
module MetaMongo where
import Database.MongoDB
import Data.UString (u)
import Control.Monad.Trans (liftIO)
import Control.Monad(liftM, filterM, foldM, foldM_)
import FlsParser
import System.IO
import MetaUtilities
import qualified Data.ByteString.Char8 as B
import Data.Bson
import qualified Data.List as L
import Text.EditDistance
import Data.List.Utils (split)
import Data.Maybe(fromJust, isJust)
import System.FilePath.Posix (takeExtensions)
import Data.CompactString as C (unpack)

colName = "events"
d = 1 :: Int
daySeconds = 86400

--need UI for
-- loading a body file
-- creating complete timeline
-- distribution comparison
-- timeline range
-- edit distance
-- grab id from file "testData/Initial"
-- grab name

--Loads a body file in the form of [BodyLine]
-- and prints out to output file
-- TESTED

doClearDB pipe = do access pipe master "test" (actionClearAll)
    where
        actionClearAll =  do
            delete (select [] "events")
            delete (select [] "timeline")
            delete (select [] "Distr")
            delete (select [] "DistrFiles")

doLoadBodyFile pipe bls =
    do fh <- openFile "testData/Initial" WriteMode
       e <- access pipe master "test" (actionInsert bls fh)
       hClose fh
       print "Wrote the damn Initial outputfile!!!"
--TESTED
doTimelineSetup pipe =
    do e <- access pipe master "test" (actionTimelineSetup)
       print "Setup the damn timeline!!!"

--TESTED
--require events database not empty
doCalcDistribution pipe =
    do e <- access pipe master "test" (actionCalcDistr)
       print "finished calculating distributions"
       print (show e)

-- look up document with id, and list of extensions. Should be a [Field]
-- for each field need to calculate the percentage of total, and compare to the same [field]
-- from original
--TESTED
--NEW METHOD
doCmpDistr name pipe fh =
    do e <- access pipe master "test" (actionCmpDistrNew fh name)
       return ()

--Tested
doTimelineRange seconds pipe fh =
    do e <- access pipe master "test" (actionTimelineRange seconds fh)
       return ()

--TESTED
doCompleteTimeline pipe fh =
    do e <- access pipe master "test" (actionTimeline fh)
       return ()

--TESTED
--NEW METHOD
doEditDistance name pipe fh =
    do e <- access pipe master "test" (correlatedDirsNew name fh)
       return ()

--NEW METHOD
doTimestampCorr name pipe fh =
    do e <- access pipe master "test" (calcTimelineRangeNew name fh)
       return ()


doSimpleEditDistance name pipe fh =
    do e <- access pipe master "test" (actionEditDistance name fh)
       return ()

--NEW METHOD
doTimeStampCorrDir name1 name2 pipe fh = do
    e <- access pipe  master "test" (timestampCorrDirNew name1 name2 fh)
    print (show e)

doEditDistanceCorrDir name1 name2 pipe fh = do
    e <- access pipe master "test" (editDistanceCorrDirNew name1 name2 fh)
    print (show e)

--TESTED
actionTimeline fh = do
    (printArray jsonID fh) =<< timeline

--Require that timeline has been created in database
actionTimelineRange seconds fh =  do
    (printArray jsonID fh) =<< (timelineRange seconds)

--Need to Correct this!!!!!!!
actionEditDistance name fh =  do
    sim <- ((findSimilar name) =<< allDocs)
    printArray jsonNoID fh sim

--setup we don't need access to this..
actionInsert bls fh = do
    clearDocs colName
    insertBls bls
    ensureIndex (index colName ["crtime" =: (1 ::Int)])
    (printArray jsonID fh) =<< allDocsSorted -- print file with ids.
	
actionTimelineSetup = do
    docs <- (rest =<< find (select [] colName))
    clearDocs "timeline"
    let times = createTimeLineDocs docs in
        insertMany "timeline" times
    ensureIndex (index "timeline" ["time" =: (1 :: Int)])

actionCmpDistr fh name =  do
        doc <- findOne (select ["name" =: name] colName)
        if (doc == Nothing)
            then do liftIO $ print "bad name, dir not found"
            else do dir <- findOne (select ["docID"=:(id (fromJust doc))] "Distr")
		    liftIO $ print (show (dir))
                    if (isJust dir)
                     then do distrFiles <- lookupDistrFiles (fromJust dir)
                             dirs <- rest =<< find (select [] "Distr")
                             result <- cmpDistr' (docToTuple (fromJust distrFiles)) dirs
                             print'' fh (filter (\e -> (snd (snd e) /= 0)) result)
                     else liftIO $ hPutStrLn fh ("invalid dir id")
    where
        id' (ObjId v) = v
        id doc = id' (valueAt "_id" doc)
        lookupDistrFiles doc =
            do idOfFileDistr <- getFileId doc
               distrFiles <- findOne (select ["_id"=:idOfFileDistr] "DistrFiles") {project = ["_id"=:(0::Int)]}
               return distrFiles
        unwrap (ObjId v) = v
        getFileId dir = return $ unwrap (valueAt "distrFiles" dir)
        cmpDistr' dir1 docs = foldM (cmpDistr'' dir1) [] docs
        cmpDistr'' dir1 acc doc = do -- dir = [(string, integer)], comparing to document, need to convert
               distrFiles <- lookupDistrFiles doc
               let result = cmpDistr dir1 (docToTuple (fromJust distrFiles)) --convert here..
                    in return ((doc, result):acc)

getTotal :: [(String, Integer)] -> Integer
getTotal xs = sum (snd (unzip xs))


cmpDistr :: [(String, Integer)] -> [(String, Integer)] -> (Double, Integer)
cmpDistr distr1 distr2 = (((fromIntegral totalMatches)/(fromIntegral numFields)), totalMatches)
    where
        totalMatches = foldr (helper distr2) 0 distr1
        --list is distr2, what you're looking into
        -- each item is expected to be from distr1
        helper :: [(String, Integer)] -> (String, Integer) -> Integer -> Integer
        helper d2 d total = if (found == Nothing)
                                then total
                                 else (if (cmpField d distr1Total foundTuple distr2Total)
                                        then total + 1
                                        else 0)
            where
                found = L.lookup (fst d) d2
                foundTuple = ((fst d), (fromJust found))
        numFields = length (L.union (fst (unzip distr1)) (fst (unzip distr2)))
        distr1Total = getTotal distr1
        distr2Total = getTotal distr2
        cmpField :: (String, Integer) -> Integer -> (String, Integer) -> Integer -> Bool
        cmpField f1 t1 f2 t2 = (p2 >= p1Min) && (p2 <= p1Max)
            where
                perc:: Integer -> Integer -> Double
                perc sum total = (fromIntegral sum)/(fromIntegral total) * 100.0
                p1 = perc (snd f1) t1
                p2 = perc (snd f2) t2
                p1Max = p1 +  5.0
                p1Min = p1 - 5.0
--tested in gchi already.. this works... thankfully.
docToTuple :: Document -> [(String, Integer)]
docToTuple fs = foldr helper [] fs
    where
        helper f acc = ((fieldToTuple f) : acc)

fieldToTuple' :: Field -> (String, Integer)
fieldToTuple' f = (l,v)
    where --more than likely will have to fix this!! similar to actionCalcDistr
        e = show f
        l = head (words e)
        v = Prelude.read ((words e) !! 1) :: Integer

fieldToTuple :: Field -> (String, Integer)
fieldToTuple ((:=) l v) = ((show l), (unwrap v))
    where
        unwrap (Int32 v) = Prelude.read (show v) :: Integer

--TESTED
actionCalcDistr =  do
       addDistrToDB =<< allDirs
    where
        addDistrToDB dirs = mapM_ (calcDistr) dirs

        calcDistr dir = do
               sub <- findSubDirs' name
               numdirs <- findSubDirsLength' name
               idDistrFiles <- insert "DistrFiles" []
               idDistr <- insert "Distr" [ docID',"name"=:name, "numDirs"=:numdirs, (distrId' idDistrFiles)]
               calcDistr' sub idDistrFiles
               return ()
            where
               name = name' (valueAt "name" dir)
               name' (String v) =  C.unpack v
               validID = valueAt "_id" dir
               docID (ObjId v) = ("docID" =: v)
               distrId' (ObjId v) = ("distrFiles" =: v)
               docID'=docID validID
               calcDistr' subfiles (ObjId id) = do save "DistrFiles" (("_id"=:id):(tupleToDoc listOfExts))
                    where
                       listOfExts = foldr (helper) [] subfiles
                       helper file acc = if (found == Nothing)
                                            then ((ext,1::Integer):acc)
                                            else newAcc
                            where
                                ext = takeExtensions(name' (valueAt "name" file))
                                found = L.lookup ext acc
                                current = fromJust found
                                newAcc = ((ext, current + 1):(L.delete (ext,current) acc))



tupleToDoc :: [(String, Integer)] -> Document
tupleToDoc xs = foldr (helper) [] xs
    where
        helper tup acc = ((u(fst tup) =: (snd tup)): acc)


insertBls bls = insertMany colName (createBLDocs bls)

clearDocs name = delete (select [] name)

allDirs = rest =<< find (select ["fileType" =: u"d/d"] colName)

allDocsSorted = rest =<< find (select [] colName) {sort = ["crtime" =: d],
                                                   project = ["name" =: d, "size" =: d, "crtime" =: d]}

timeline = rest =<< find (select [] "timeline") {sort = ["time" =: d]}

--pulling from the original events database...
allDocs = rest =<< find (select [] colName)

--find a directory
findDirectory did = findOne (select ["fileType"=:u"d/d", "_id"=:did] colName)
findDirectory' name = findOne (select ["fileType"=:u"d/d", "name"=:name] colName)

--findsubdirs was incorrect, was grabbing the full tree, when just needed one level
--allDirectories = rest =<< find (select ["fileType" =: u"d/d"] colName)
--findSubDirs dir = rest =<< find (select ["name" =: ["$regex" =: u(dir ++ "/.")]] colName)
--(rest =<< find (select ["addr" =: ["$regex" =: "abcde/."]] "posts"))


--findAllDirectory = rest =<< find (select ["fileType"=:u"d/d"] colName)
--, make sure directory is valid, define comparedir method
correlatedDirs name fh = do
    valid <- findDirectory' name -- could also try findOne
    if valid == Nothing
        then return ()
        else do
          all <- (rest =<< find (select ["fileType" =: u"d/d"] colName))
          subfiles <- findSubDirs' (nameOfDir (fromJust valid))
          eDistance <- editDistanceCorr subfiles all
          print'' fh eDistance
        where
            nameOfDir x = name' (valueAt "name" x)
            name' (String v) =  C.unpack v

-- [Documents] -> CorrValueForEditDistance..
--- takes subdirectories of interesting directory, and list of directories to compare to.
--- and returns list of tuples, (Document, numHits)
-- take this set of documents and compare it to each directory's subdirs
editDistanceCorr subdirs dirs =  do result <- mapM (editDir2Dir subdirs) dirs
                                    return (filter (\e -> (snd(snd e) /= 0)) result)

        --may change this, may return id, name, value, instead...
editDir2Dir subdirs dir = do subfiles <- findSubDirs' (name' (valueAt "name" dir))
                             let numFiles = fromIntegral (length subfiles)
                                 hits = fromInteger (numEditHits subfiles dir)
                              in if (numFiles == 0)
                                    then return (dir, (0,0))
                                    else return (dir, (hits/numFiles, hits))
            where
                name' (String v) =  C.unpack v
-- This is still for only the current set of files vs. one dir files...
--[Documents] -> [Documents] -> Integer.
-- take a list of documents and return the number of hits
numEditHitsSet :: [Document] -> [Document] -> Integer
numEditHitsSet search subdirs = sum (map (numEditHits subdirs) search)

--document -> [Documents] -> Integer
-- returns the number of hits for one subdir name compared to the set.
numEditHits :: [Document] -> Document -> Integer
numEditHits subdirs dir = foldr helper 0 subdirs
    where
        helper doc current = if (similarNameDoc dir 5 doc) then (current + 1)
                             else current


editDistanceCorrDir name1 name2 fh = do
    valid1 <- findDirectory' name1
    valid2 <- findDirectory' name2
    if ((valid1 == Nothing) || (valid2 == Nothing))
        then do liftIO $ print "directory invalid"
        else do subfiles <- findSubDirs' (nameOfDir (fromJust valid1))
                result <- editDir2Dir subfiles (fromJust valid2)
                liftIO $ print result
                liftIO $ hPrint fh result
    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) = C.unpack v

timestampCorrDir name1 name2 fh = do
    valid1 <- findDirectory' name1
    valid2 <- findDirectory' name2
    if ((valid1 == Nothing) || (valid2 == Nothing))
        then do liftIO $ print "directory invalid"
        else do subfiles <- findSubDirs' (nameOfDir (fromJust valid1))
                result <- timeDir2Dir subfiles (fromJust valid2)
                liftIO $ print result
                liftIO $ hPrint fh result
    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) =  C.unpack v

--timelineRange hits
calcTimelineRange name fh = do
    valid <- findDirectory' name -- could also try findOne
    if valid == Nothing
        then do liftIO $ hPutStrLn fh "bad directory name"
        else do
          -- get all directories except for the one already given
          all <- (rest =<< find (select ["fileType" =: u"d/d", "name" =: ["$ne"=:name]] colName))
          subfiles <- findSubDirs' (nameOfDir (fromJust valid))
          stampHits <- timestampCorr valid subfiles all
          print'' fh stampHits
        where
            nameOfDir x = name' (valueAt "name" x)
            name' (String v) =  C.unpack v


findSubDirsLength' dir = do result <- findSubDirs' dir
                            return (length result)
findSubDirs' dir = do subs <- rest =<< find (select ["name" =: ["$regex" =: u(dir ++ "/.")]] colName)
                      return (filter (oneLevel) subs)
                   where
                     oneLevel doc = ((levelSub - levelOrigin) == 1)
                        where
                           levelOrigin = length (split "/" dir)
                           levelSub = length (split "/" (nameOfDir doc))
                           nameOfDir x = name' (valueAt "name" x)
                           name' (String v) =  C.unpack v

-- subfiles, are teh subfiles of the directory taken from user
-- all is the list of all directories
timestampCorr dir subfiles all = do result <- mapM (timeDir2Dir subfiles) all
                                    return (filter (\e -> (snd (snd e) /= 0)) result)
    --subfiles here is still the list of subfiles from user
    -- dir is one of th emany directories we are comparing too
timeDir2Dir subfiles dir = do hits <- stampHitsTotal subfiles dir
                              if (numFiles == 0)
                                  then return (dir, (0.0,0))
                                  else return (dir, ((fromIntegral hits)/numFiles, hits))
                            where
                                 numFiles = fromIntegral (length subfiles)
                                 name' (String v) = C.unpack v
-- iterate through subfiles, calculating sum hits for the current directory
-- returns how many times any file in the subfile group found a file in range
-- in the given directory.
stampHitsTotal subfiles dir = do result <- mapM (numStampHits' dir) subfiles
                                 return (sum result)

-- interestedDirectory = dirA
-- count total number of hits per directory for dirA.
--  - take every file in dirA and calculate number of hits per directory.
--  - sum them all.
-- returns the number of hits for one subdir name compared to the set.
-- targetDir, is the directory we are searching through
-- fileA is the file from the set of subfiles in the original directory
-- could also return the query here if we wanted, but don't really need to.
numStampHits targetDir fileA = do c <- count (timelineRange' atime mtime ctime crtime parent)
                                  return c
    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) =  C.unpack v
        parent = nameOfDir targetDir
        atime = time (valueAt "atime" fileA)
        mtime = time (valueAt "mtime" fileA)
        ctime = time (valueAt "ctime" fileA)
        crtime = time (valueAt "crtime" fileA)
        time (Int32 v) = Prelude.read (show v) :: Integer

numStampHits' targetDir fileA = do subs <- findSubDirs' parent
                                   return $ length (filter (timestampRange' atime mtime ctime crtime) subs)

    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) = C.unpack v
        parent = nameOfDir targetDir
        atime = time (valueAt "atime" fileA)
        mtime = time (valueAt "mtime" fileA)
        ctime = time (valueAt "ctime" fileA)
        crtime = time (valueAt "crtime" fileA)
        time (Int32 v) = Prelude.read (show v) :: Integer

-- if any of the subfiles timestamps is within the range of any of the
-- given timestamps, return true.
timestampRange' atime mtime ctime crtime sub =
    (ats <= atM) || (ats >= atL) ||
    (ats <= mtM) || (ats >= mtL) ||
    (ats <= ctM) || (ats >= ctL) ||
    (ats <= crtM) || (ats >= crtL) ||
    (mts <= atM) || (mts >= atL) ||
    (mts <= mtM) || (mts >= mtL) ||
    (mts <= ctM) || (mts >= ctL) ||
    (mts <= crtM) || (mts >= crtL) ||
    (cts <= atM) || (cts >= atL) ||
    (cts <= mtM) || (cts >= mtL) ||
    (cts <= ctM) || (cts >= ctL) ||
    (cts <= crtM) || (cts >= crtL) ||
    (crts <= atM) || (crts >= atL) ||
    (crts <= mtM) || (crts >= mtL) ||
    (crts <= ctM) || (crts >= ctL) ||
    (crts <= crtM) || (crts >= crtL)
    where
        ats = time (valueAt "atime" sub)
        mts = time (valueAt "mtime" sub)
        cts = time (valueAt "ctime" sub)
        crts = time (valueAt "crtime" sub)
        time (Int32 v) = Prelude.read (show v) :: Integer
        lower t = t - daySeconds
        upper t = t + daySeconds
        atL = lower atime
        atM = upper atime
        mtL = lower mtime
        mtM = upper mtime
        ctL = lower ctime
        ctM = upper ctime
        crtL = lower crtime
        crtM = upper crtime

timelineRange timeStamp = rest =<< find (select ["time" =: ["$gt" =: (timeStamp - daySeconds), "$lt" =: (timeStamp + daySeconds)]] "timeline") {sort = ["time" =: d]}


timelineRange' atime mtime ctime crtime dirName =
    (select ["$or" =: [
	                  ["atime" =: ["$gt" =: atL, "$lt" =: atM]],
	                  ["atime" =: ["$gt" =: mtL, "$lt" =: mtM]],
	                  ["atime" =: ["$gt" =: ctL, "$lt" =: ctM]],
	                  ["atime" =: ["$gt" =: crtL, "$lt" =: crtM]],
	                  ["mtime" =: ["$gt" =: atL, "$lt" =: atM]],
	                  ["mtime" =: ["$gt" =: mtL, "$lt" =: mtM]],
	                  ["mtime" =: ["$gt" =: ctL, "$lt" =: ctM]],
	                  ["mtime" =: ["$gt" =: crtL, "$lt" =: crtM]],
	                  ["ctime" =: ["$gt" =: atL, "$lt" =: atM]],
	                  ["ctime" =: ["$gt" =: mtL, "$lt" =: mtM]],
	                  ["ctime" =: ["$gt" =: ctL, "$lt" =: ctM]],
	                  ["ctime" =: ["$gt" =: crtL, "$lt" =: crtM]],
	                  ["crtime" =: ["$gt" =: atL, "$lt" =: atM]],
	                  ["crtime" =: ["$gt" =: mtL, "$lt" =: mtM]],
	                  ["crtime" =: ["$gt" =: ctL, "$lt" =: ctM]],
	                  ["crtime" =: ["$gt" =: crtL, "$lt" =: crtM]]],
	                  "name" =: ["$regex"=:u(dirName ++ "/.")]] colName)
    where
        lower t = t - daySeconds
        upper t = t + daySeconds
        atL = lower atime
        atM = upper atime
        mtL = lower mtime
        mtM = upper mtime
        ctL = lower ctime
        ctM = upper ctime
        crtL = lower crtime
        crtM = upper crtime
{--
timelineRange' atime mtime ctime crtime dirName =
    (select ["$or" =: ["atime" =: ["$gt"=:atimeL, "$lt"=:atimeM], "mtime"=: ["$gt"=:mtimeL, "$lt"=:mtimeM],"ctime"=: ["$gt"=:ctimeL, "$lt"=:ctimeM],"crtime" =: ["$gt"=:crtimeL, "$lt"=:crtimeM]],"name" =: ["$regex"=:u(dirName ++ "/.")]] colName)
    where
        lower t = t - daySeconds
        upper t = t + daySeconds
        atL = lower atime
        atM = upper atime
        mtL = lower mtime
        mtM = upper mtime
        ctL = lower ctime
        ctM = upper ctime
        crtL = lower crtime
        crtM = upper crtime
--}
--edit distance
findSimilar name docs = return (filter (similarName name 5) docs)

--Wtf does liftIO actually mean....
print' title docs = liftIO $ mapM_ (print . exclude ["_id"]) docs
printJson fh docs = liftIO $ mapM_ ((hPutStrLn fh).showJson.exclude ["_id"]) docs
printJson' fh docs = liftIO $ mapM_ ((hPutStrLn fh).showJson) docs

--Print [(Document, Float)]

print'' fh docs = liftIO $ mapM_ (hPutStrLn fh.show) docs

testNewPrintJson fh docs = liftIO $ mapM_ ((hPutStrLn fh).showJson'.exclude ["_id"]) docs
testNewPrintJson' fh docs = liftIO $ mapM_ ((hPutStrLn fh).showJson') docs

printArray jp fh docs = liftIO $ do
       hPutStrLn fh "["
       liftIO $ mapM_ (printElement jp fh) (L.init docs)
       hPutStrLn fh (jp (L.last docs))
       hPutStrLn fh "]"

printElement jp fh doc = (hPutStrLn fh) ((jp doc) ++ ",")

jsonID doc = showJson' doc
jsonNoID doc = (showJson'.exclude["_id"]) doc

createBLDocs :: [BodyLine] -> [Document]
createBLDocs bls = map (createBLDocPOSIX) bls

createTimeLineDocs :: [Document] -> [Document]
createTimeLineDocs docs = foldr step [] docs
    where
        step doc acc = (splitTimes doc) ++ acc


--to make simpler may just store both posix and utc in the same file.
splitTimes :: Document -> [Document]
splitTimes doc = aDoc:mDoc:cDoc:crDoc:[]
    where
        id = (valueAt "_id" doc)
        docID (ObjId v) = ("docID" =: v)
        docID'=docID id
        time (Int32 v) = ("time" =: v)
        --time (UTC v) = ("time" =: v) -- if we use UTC instead of posix seconds
        aDoc = docID':(time (valueAt "atime" doc)):("type" =: u"atime"):[]
        mDoc = docID':(time (valueAt "mtime" doc)):("type" =: u"mtime"):[]
        cDoc = docID':(time (valueAt "ctime" doc)):("type" =: u"ctime"):[]
        crDoc = docID':(time (valueAt "crtime" doc)):("type" =: u"crtime"):[]


createBLDocPOSIX :: BodyLine -> Document
createBLDocPOSIX bl =
	["md5" =: (md5 bl),
	 "name" =: u(B.unpack(fn bl)),
	 "inode" =: u(inodeToString (inode bl)),
	 "fileType" =: u(fileTypeToString (fileType bl)),
	 "filePerms" =: u(filePermsToString(filePerms bl)),
	 "uid" =: (uid bl),
	 "gid" =: (gid bl),
	 "size" =: (size bl),
	 "atime" =: (atime bl),
	 "mtime" =: (mtime bl),
	 "ctime" =: (ctime bl),
	 "crtime" =:(crtime bl)]
{--
createBLDocUTC :: BodyLine -> Document
createBLDocUTC bl =
	["md5" =: (md5 bl),
	 "name" =: u(B.unpack(fn bl)),
	 "inode" =: u(inodeToString (inode bl)),
	 "fileType" =: u(fileTypeToString (fileType bl)),
	 "filePerms" =: u(filePermsToString(filePerms bl)),
	 "uid" =: (uid bl),
	 "gid" =: (gid bl),
	 "size" =: (size bl),
	 "atime" =: (convertTimeStampUTC (atime bl)),
	 "mtime" =: (convertTimeStampUTC (mtime bl)),
	 "ctime" =: (convertTimeStampUTC (ctime bl)),
	 "crtime" =: (convertTimeStampUTC (crtime bl))]
--}

similarNameDoc :: Document -> Int -> Document -> Bool
similarNameDoc search thresh doc = ((levenshteinDistance defaultEditCosts searchName docName) <= thresh)
    where
        docName = fileName doc
        searchName = fileName search
        fileName doc = getLast (split "/" (name doc))
        name doc = name' (valueAt "name" doc)
        name' (String v) = C.unpack v
        getLast (x:[]) = x
        getLast (x:xs) = getLast xs


similarName :: String -> Int -> Document -> Bool
similarName search thresh doc = ((levenshteinDistance defaultEditCosts search filename) <= thresh)
    where
        filename = getLast (split "/" (name doc))
        name x = name' (valueAt "name" x)
        name' (String v) = C.unpack v
        getLast (x:[]) = x
        getLast (x:xs) = getLast xs


--Newly created functions trying to utilize proper set theory

actionCmpDistrNew fh name =  do
        doc <- findOne (select ["name" =: name] colName) -- get id of given directory
        if (doc == Nothing)
            then do liftIO $ print "bad name, dir not found"
            else do dir <- findOne (select ["docID"=:(id (fromJust doc))] "Distr") -- get distrinfo for given doc
		    liftIO $ print (show (dir))
                    if (isJust dir) -- did we find the directory? good
                     then do distrFiles <- lookupDistrFiles (fromJust dir) -- get ext info for given dir
                             dirs <- rest =<< find (select [] "Distr") -- retrieve all the other directories
                             result <- cmpDistr' (docToTuple (fromJust distrFiles)) dirs -- now compare given dir to all dirs
                             print'' fh (filter (\e -> (snd e) /= 0) result)
                     else liftIO $ hPutStrLn fh ("invalid dir id")
    where
        id' (ObjId v) = v
        id doc = id' (valueAt "_id" doc)
        lookupDistrFiles doc =
            do idOfFileDistr <- getFileId doc
               distrFiles <- findOne (select ["_id"=:idOfFileDistr] "DistrFiles") {project = ["_id"=:(0::Int)]}
               return distrFiles
        unwrap (ObjId v) = v
        getFileId dir = return $ unwrap (valueAt "distrFiles" dir)
        cmpDistr' dir1 docs = foldM (cmpDistr'' dir1) [] docs -- loop comparing given distr to each other dirs distr
        cmpDistr'' dir1 acc doc = do -- dir = [(string, integer)], comparing to document, need to convert
               distrFiles <- lookupDistrFiles doc
               let result = cmpDistrNew dir1 (docToTuple (fromJust distrFiles)) --convert here..
                    in return ((doc, result):acc)
                       
cmpDistrNew :: [(String, Integer)] -> [(String, Integer)] -> Double
cmpDistrNew distr1 distr2 = sizeInt/sizeUn * 100.0
    where
        getSet list = L.nubBy distrEq (convertToDistr list)
        distr1' = getSet distr1
        distr2' = getSet distr2
        jacInt = L.intersectBy distrEq distr1' distr2'
        jacUn = L.unionBy distrEq distr1' distr2'
        sizeInt = fromIntegral (length jacInt)
        sizeUn = fromIntegral (length jacUn)


distrEq :: (String, Double) -> (String, Double) -> Bool
distrEq (ext1, distr1) (ext2, distr2) = (ext1 == ext2) && (distr2 >= d1Min) && (distr2 <= d1Max) 
      where
          d1Min = distr1 - 5.0
          d1Max = distr1 + 5.0

convertToDistr :: [(String, Integer)] -> [(String, Double)]
convertToDistr list = map (helper (getTotal list)) list
     where
         helper :: Integer -> (String,Integer) -> (String, Double)
         helper t (ext, occurrences) = (ext, dist)
              where
                dist = (fromIntegral occurrences)/(fromIntegral t)
                
                
--findAllDirectory = rest =<< find (select ["fileType"=:u"d/d"] colName)
--, make sure directory is valid, define comparedir method
correlatedDirsNew name fh = do
    valid <- findDirectory' name -- could also try findOne
    if valid == Nothing
        then return ()
        else do
          all <- (rest =<< find (select ["fileType" =: u"d/d"] colName))
          subfiles <- findSubDirs' (nameOfDir (fromJust valid))
          eDistance <- editDistanceCorrNew subfiles all
          print'' fh eDistance
        where
            nameOfDir x = name' (valueAt "name" x)
            name' (String v) =  C.unpack v

-- [Documents] -> CorrValueForEditDistance..
--- takes subdirectories of interesting directory, and list of directories to compare to.
--- and returns list of tuples, (Document, numHits)
-- take this set of documents and compare it to each directory's subdirs
editDistanceCorrNew subdirs dirs =  do result <- mapM (editDir2DirNew subdirs) dirs
                                       return (filter (\e -> (snd e) /= 0) result)

        --may change this, may return id, name, value, instead...
editDir2DirNew subdirs dir = do subfiles <- findSubDirs' (name' (valueAt "name" dir))
                                jacIndex <- return (jacName (getNames subdirs) (getNames subfiles))
                                return (dir, jacIndex)
                          where
                            name' (String v) = C.unpack v      

getNames :: [Document] -> [String]
getNames docs = map getName docs 

--takes a document and returns a string with name and no path info
getName :: Document -> String
getName doc = getLast (split "/" (name doc))
     where
         name doc = name' (valueAt "name" doc)
         name' (String v) = C.unpack v
         getLast (x:[]) = x
         getLast (x:xs) = getLast xs
        
        
--two lists of strings with names from each docs
--assumes that I have only filenames.. with no path...
jacName :: [String] -> [String] -> Double
jacName dir1 dir2 = sizeInt/sizeUn * 100.0
     where  
        getSet list = L.nubBy nameEq list
        dir1' = getSet dir1
        dir2' = getSet dir2
        jacInt = L.intersectBy nameEq dir1' dir2'
        jacUn = L.unionBy nameEq dir1' dir2'
        sizeInt = fromIntegral (length jacInt)
        sizeUn = fromIntegral (length jacUn)
         

nameEq :: String -> String -> Bool
nameEq name1 name2 = (levenshteinDistance defaultEditCosts name1 name2) <= 5
        
calcTimelineRangeNew name fh = do
    valid <- findDirectory' name -- could also try findOne
    if valid == Nothing
        then do liftIO $ hPutStrLn fh "bad directory name"
        else do
          -- get all directories except for the one already given
          all <- (rest =<< find (select ["fileType" =: u"d/d", "name" =: ["$ne"=:name]] colName))
          subfiles <- findSubDirs' (nameOfDir (fromJust valid))
          stampHits <- timestampCorrNew valid subfiles all
          print'' fh stampHits
        where
            nameOfDir x = name' (valueAt "name" x)
            name' (String v) =  C.unpack v
            

getTimeStampsList :: [Document] -> [Integer]
getTimeStampsList list = foldr getTimeStamps [] list

getTimeStamps :: Document -> [Integer] -> [Integer]
getTimeStamps doc acc = atime:mtime:ctime:crtime:acc
     where
        atime = time (valueAt "atime" doc)
        mtime = time (valueAt "mtime" doc)
        ctime = time (valueAt "ctime" doc)
        crtime = time (valueAt "crtime" doc)
        time (Int32 v) = Prelude.read (show v) :: Integer
        
timeSub2Sub subfiles1 subfiles2 = sizeInt/sizeUn * 100.0
     where
         getSet tsList = L.nubBy tsEq (getTimeStampsList tsList)
         ts1 = getSet subfiles1
         ts2 = getSet subfiles2
         jacInt = L.intersectBy tsEq ts1 ts2
         jacUn = L.unionBy tsEq ts1 ts2
         sizeInt = fromIntegral (length jacInt)
         sizeUn = fromIntegral (length jacUn)
         
         
tsEq ts1 ts2 = (ts2 <= tsMax) && (ts2 >= tsMin)
  where
      tsMin = lower ts1
      tsMax = upper ts1
      lower t = t - daySeconds
      upper t = t + daySeconds

timestampCorrNew dir subfiles all = do result <- mapM (timeDir2DirNew subfiles) all
                                       return (filter (\e -> (snd e /= 0)) result)
            
timeDir2DirNew subfiles doc = do subfiles2 <- findSubDirs' (nameOfDir doc) 
                                 return (doc, (timeSub2Sub subfiles subfiles2))
     where
         nameOfDir x = name' (valueAt "name" x)
         name' (String v) =  C.unpack v
         
         
timestampCorrDirNew name1 name2 fh = do
    valid1 <- findDirectory' name1
    valid2 <- findDirectory' name2
    if ((valid1 == Nothing) || (valid2 == Nothing))
        then do liftIO $ print "directory invalid"
        else do subfiles <- findSubDirs' (nameOfDir (fromJust valid1))
                result <- timeDir2DirNew subfiles (fromJust valid2)
                liftIO $ print result
                liftIO $ hPrint fh result
    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) =  C.unpack v
        
        
editDistanceCorrDirNew name1 name2 fh = do
    valid1 <- findDirectory' name1
    valid2 <- findDirectory' name2
    if ((valid1 == Nothing) || (valid2 == Nothing))
        then do liftIO $ print "directory invalid"
        else do subfiles <- findSubDirs' (nameOfDir (fromJust valid1))
                result <- editDir2DirNew subfiles (fromJust valid2)
                liftIO $ print result
                liftIO $ hPrint fh result
    where
        nameOfDir x = name' (valueAt "name" x)
        name' (String v) = C.unpack v